home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / lib / tcl / mxedit.utils < prev    next >
Text File  |  1992-07-17  |  26KB  |  1,087 lines
  1. #
  2. # mxedit.utils --
  3. #
  4. # This script defines basic editing operations for the mxedit widget.
  5. # This has the core functionality of the editor.  The procedures here
  6. # rely on the global variable "mxedit" that identifies the file editing
  7. # widget.  This widget supports a couple dozen operations, and the
  8. # procs in this file are layers on these operations.  Many are thin
  9. # layers that just hide the use of this global variable.  Others are
  10. # useful combinations of low-level edit operations.  Finally, others
  11. # are more complex layers that put up dialog boxes to handle error cases.
  12. #
  13. # Copyright (c) 1992 Xerox Corporation.
  14. # Use and copying of this software and preparation of derivative works based
  15. # upon this software are permitted. Any distribution of this software or
  16. # derivative works must comply with all applicable United States export
  17. # control laws. This software is made available AS IS, and Xerox Corporation
  18. # makes no warranty about the software, its performance or its conformity to
  19. # any specification.
  20.  
  21. # Global variables that can be redefined by the user
  22. # indent - the number of spaces for indentation
  23.  
  24. ######################## FILE PROCEDURES ########################
  25.  
  26. # These procedures are layers on the raw mxedit commands
  27. # write, reset, switch, quit
  28. # that protect against losing modified files
  29. # Ordinarily these file-related procedures are accessed via the File menu
  30. # Most of these commands pop up dialog boxes to handle error conditions
  31.  
  32. # save [filename] --
  33. #    Write out the buffer to the current or named file
  34.  
  35. proc save { args } {
  36.     global mxedit file
  37.     if {[llength $args]>0} {
  38.     set filename [lindex $args 0]
  39.     saveInner $filename [list $mxedit write $filename]
  40.     } else {
  41.     saveInner $file [list $mxedit write]
  42.     }
  43. }
  44.  
  45. # saveSel --
  46. #    Write out the file using the selection as the filename
  47.  
  48. proc saveSel { } {
  49.     global mxedit
  50.     if [catch {selection get} filename] {
  51.     mxFeedback $filename
  52.     } else {
  53.     saveInner $filename [list $mxedit write $filename]
  54.     }
  55. }
  56.  
  57. # saveInner --
  58. #    Inner core of saving a file.  This checks for write errors
  59. #    and puts up various dialog boxes to deal with them.
  60.  
  61. proc saveInner { file writeCommand } {
  62.     global mxedit
  63.     global paleBackground
  64.  
  65.     mxFeedback "Writing $file ..." ; update
  66.     if [catch $writeCommand msg] {
  67.     mxFeedback $msg
  68.     case $msg in {
  69.         {{Cannot write*}} {
  70.         toplevel .writefailed -background $paleBackground
  71.         wm title .writefailed "$msg"
  72.         buttonFrame .writefailed .buttons
  73.         packedButton .writefailed.buttons .quit \
  74.             "Cannot save $file" \
  75.             "destroy .writefailed" left
  76.         placePopUp .writefailed center
  77.         }
  78.         {{File exists*}} {
  79.         toplevel .fileexists -background $paleBackground
  80.         wm title .fileexists "$msg"
  81.         buttonFrame .fileexists .buttons
  82.         packedButton .fileexists.buttons .skip \
  83.             "Skip command" \
  84.             "destroy .fileexists" left
  85.         packedButton .fileexists.buttons .write \
  86.             "Overwrite existing $file" \
  87.             "mxFeedback \"Writing $file\" ; \
  88.             $mxedit write $file force ; \
  89.             destroy .fileexists" left
  90.         placePopUp .fileexists center
  91.         }
  92.         {{File modified*}} {
  93.         toplevel .filemodified -background $paleBackground
  94.         wm title .filemodified "$msg"
  95.         buttonFrame .filemodified .buttons
  96.         packedButton .filemodified.buttons .skip \
  97.             "Skip command" "destroy .filemodified" left
  98.         packedButton .filemodified.buttons .write \
  99.             "Overwrite modified $file" \
  100.             "mxFeedback \"Writing $file\" ; \
  101.             $mxedit write $file force ; \
  102.             destroy .filemodified" left
  103.         placePopUp .filemodified center
  104.         }
  105.         default {
  106.         toplevel .badwrite -background $paleBackground
  107.         wm title .badwrite "$msg"
  108.         buttonFrame .badwrite .buttons
  109.         packedButton .badwrite.buttons .quit \
  110.             "Bad TCL write cmd for $file" \
  111.             "destroy .badwrite" left
  112.         placePopUp .badwrite center
  113.         }
  114.     }
  115.     return $msg
  116.     } else {
  117.     mxFeedback $msg
  118.     }
  119. }
  120.  
  121. # reset --
  122. #    Reinitialize the contents of the mxedit window from the disk file.
  123.  
  124. proc reset { } {
  125.     global mxedit
  126.     if [catch {$mxedit written} msg] {
  127.     mxFeedback $msg
  128.     resetdialog $msg
  129.     return $msg
  130.     } else {
  131.     return [resetAlways]
  132.     }
  133. }
  134.  
  135. # resetAlways --
  136.  
  137. proc resetAlways { } {
  138.     global mxedit
  139.     # Save the current position, even though it won't be perfect
  140.     # after the reset, it probably will be close
  141.     set _c [mark caret]
  142.     if [catch {$mxedit reset force} msg] {
  143.     return $msg
  144.     } else {
  145.     mxWindowNameFix
  146.     caret $_c
  147.     see caret
  148.     mxFeedback $msg
  149.     return $msg
  150.     }
  151. }
  152.  
  153. # resetdialog --
  154.  
  155. proc resetdialog { msg } {
  156.     global mxedit
  157.     global paleBackground
  158.     toplevel .resetdialog -background $paleBackground
  159.     wm title .resetdialog $msg
  160.     wm transient .resetdialog
  161.  
  162.     buttonFrame .resetdialog .buttons
  163.     packedButton .resetdialog.buttons .reset \
  164.         "Reset anyway" \
  165.         "resetAlways ; destroy .resetdialog" left
  166.     packedButton .resetdialog.buttons .skip \
  167.         "Skip command" "destroy .resetdialog" left
  168.  
  169.     placePopUp .resetdialog center
  170. }
  171.  
  172. # switch --
  173. #    Change to a different file
  174.  
  175. proc sw { filename } { switch $filename }
  176. proc switch { filename } {
  177.     global mxedit
  178.     if [catch {$mxedit written} msg] {
  179.     mxFeedback $msg
  180.     switchdialog $msg $filename
  181.     } else {
  182.     switchAlways $filename
  183.     }
  184. }
  185.  
  186. # switchAlways --
  187. #    Always switch files, even if the current on is dirty
  188. #    This procedure remembers the previous file and position
  189. #    for use with the switchBack command
  190.  
  191. proc switchAlways { filename } {
  192.     global mxedit
  193.     global file
  194.     global lastFile lastCaret
  195.     set _f $file
  196.     set _c [mark caret]
  197.     if [catch {$mxedit switch $filename force} msg] {
  198.     mxFeedback "Switch failed: $msg"
  199.     } else {
  200.     set lastFile $_f
  201.     set lastCaret $_c
  202.     mxWindowNameFix
  203.     mxFeedback $msg
  204.     return $msg
  205.     }
  206. }
  207.  
  208. # switchBack --
  209. #    Switch back to the previous file
  210. proc switchBack { } {
  211.     global lastFile lastCaret
  212.     if [catch {set lastFile}] {
  213.     mxFeedback "No previous file to switch back to"
  214.     } else {
  215.     set _p $lastCaret
  216.     switch $lastFile
  217.     caret $_p
  218.     see caret
  219.     }
  220. }
  221.  
  222. # switchdialog --
  223.  
  224. proc switchdialog { msg filename } {
  225.     global mxedit
  226.     global paleBackground
  227.     toplevel .switchdialog -background $paleBackground
  228.     wm title .switchdialog $msg
  229.     wm transient .switchdialog
  230.  
  231.     buttonFrame .switchdialog .buttons
  232.     packedButton .switchdialog.buttons .switch \
  233.         "Switch anyway" \
  234.         "switchAlways $filename ; destroy .switchdialog" left
  235.     packedButton .switchdialog.buttons .write \
  236.         "Save instead" \
  237.         "save ; destroy .switchdialog" left
  238.     packedButton .switchdialog.buttons .skip \
  239.         "Skip command" \
  240.         "destroy .switchdialog" left
  241.  
  242.     placePopUp .switchdialog center
  243. }
  244.  
  245. # quit --
  246. #    Quit the editing session.  This checks against a modified file
  247. #    and puts up a dialog to ask confirmation in that case.
  248.  
  249. proc quit { } {
  250.     global mxedit 
  251.     if [catch {$mxedit written} msg] {
  252.     mxFeedback $msg
  253.     quitdialog $msg
  254.     } else {
  255.     destroy .
  256.     }
  257. }
  258.  
  259. # quitdialog --
  260.  
  261. proc quitdialog { msg } {
  262.     global mxedit
  263.     global paleBackground
  264.     toplevel .quitdialog -background $paleBackground
  265.     wm title .quitdialog $msg
  266.     wm transient .quitdialog
  267.  
  268.     buttonFrame .quitdialog .buttons
  269.     packedButton .quitdialog.buttons .quit \
  270.         "Quit anyway" "destroy ." left
  271.     packedButton .quitdialog.buttons .write \
  272.         "Save instead" "save ; destroy .quitdialog" left
  273.     packedButton .quitdialog.buttons .skip \
  274.         "Skip command" "destroy .quitdialog" left
  275.  
  276.     placePopUp .quitdialog center
  277. }
  278.  
  279. # Provide an alias for mxopen
  280. proc edit { args } {
  281.     mxFeedback "Edit $args"
  282.     eval "mxopen $args"
  283. }
  284.  
  285. ########################### EDIT PROCEDURES ###########################
  286.  
  287. # undo --
  288. #    Undo the previous editing command.  mxedit provides a complete
  289. #    editing log so repeated invocations of undo keeps undoing more.
  290. #    Hint: to roll forward after undoing a lot, insert a space, then
  291. #    go back to using undo repeatedly.  Go ahead, confuse yourself.
  292.  
  293. proc undo { } {
  294.     global mxedit
  295.     if [catch {$mxedit history next history [list $mxedit undo more]} msg] {
  296.     mxFeedback $msg
  297.     return $msg
  298.     }
  299. }
  300.  
  301. # redo --
  302. #    Redo the previous editing sequence.
  303. #    Each sequence is delimited by mouse clicks;
  304. #    there are no explicit "start" and "stop" remembering commands.
  305. #    Note: redo depends on a call to
  306. #    $mxedit history on
  307. #    in order to turn history on
  308.  
  309. proc redo { } {
  310.     global mxedit history
  311.     if [catch {
  312.         $mxedit history add $history
  313.         $mxedit history ignore "eval $history"
  314.           } msg] {
  315.     mxFeedback $msg
  316.     return $msg
  317.     }
  318. }
  319.  
  320. # delete --
  321. #    delete mark1 [mark2 [noviewchange]]
  322. #    Delete the specified region
  323.  
  324. proc delete { args } {
  325.     global mxedit
  326.     eval "$mxedit delete $args"
  327. }
  328.  
  329. # deleteSel --
  330. #    Delete the selection
  331.  
  332. proc deleteSel { } {
  333.     if [catch {delete sel.left sel.right}] {
  334.     mxFeedback "nothing is selected in this file"
  335.     }
  336. }
  337.  
  338. # deleteSave --
  339. #    Delete the selection and save it in a variable
  340.  
  341. proc deleteSave { } {
  342.     global _saved
  343.     if [mxselection here] {
  344.     set _saved [selection get]
  345.     delete sel.left sel.right
  346.     } else {
  347.     mxFeedback "Selection not in window"
  348.     }
  349. }
  350.  
  351. # batchDelete --
  352. #    batchDelete uses the ! syntax to batch up a history log entry.
  353. #    This means that many deletes in a row are undone as one operation.
  354.  
  355. proc batchDelete { args } {
  356.     global mxedit
  357.     eval "$mxedit ! delete $args"
  358. }
  359.  
  360. # deleteForwChar --
  361.  
  362. proc deleteForwChar { } {
  363.     batchDelete caret
  364. }
  365.  
  366. # deleteBackChar --
  367.  
  368. proc deleteBackChar { } {
  369.     batchDelete [mark caret back 1 char]
  370. }
  371.  
  372. # deleteBackWord --
  373.  
  374. proc deleteBackWord { } {
  375.     batchDelete [mark caret back 1 word] [mark caret back 1 char]
  376. }
  377.  
  378. # deleteForwWord --
  379.  
  380. proc deleteForwWord { } {
  381.     batchDelete caret [mark [mark caret forw 1 word] back 1 char]
  382. }
  383.  
  384. # deleteEndOfLine --
  385.  
  386. proc deleteEndOfLine { } {
  387.     if {[string compare [mark caret] [mark caret char -1]] != 0} {
  388.     delete caret [mark [mark caret char -1] back 1 char]
  389.     } else {
  390.     delete [mark caret]
  391.     }
  392. }
  393.  
  394. # deleteLine --
  395.  
  396. proc deleteLine { } {
  397.     if {[string compare [mark caret] [mark caret char -1]] != 0} {
  398.     delete [mark caret char 0] [mark caret char -1]
  399.     } else {
  400.     delete [mark caret]
  401.     }
  402. }
  403.  
  404. # moveSel --
  405. #    Move the selection to the insert pointselection
  406. #    TODO - figure out how to allow insertion of selections
  407. #    that contain escaped newlines while preserving the backslash
  408.  
  409. proc moveSel {  } {
  410.     if [mxselection here] {
  411.     set _t [mark caret]
  412.     insert [selection get]
  413.     set _l [mark sel.left]
  414.     set _r [mark sel.right]
  415.     mxselection set $_t [mark caret back 1 char]
  416.     delete $_l $_r noviewchange
  417.     } else {
  418.     mxFeedback "selection not in this window"
  419.     }
  420. }
  421.  
  422. # paste --
  423. #    Insert the selection at the insert point.
  424. #    In order to support things like OpenLook that have a cut-then-paste
  425. #    paradigm, we fall back to inserting the saved selection on the
  426. #    assumption that the user has done a recent cut.  This only
  427. #    works within a single window, however...
  428. #    TODO - add support for the cut buffer to TK
  429.  
  430. proc paste { } {
  431.     if [catch {insert [selection get]}] {
  432.     pasteSave
  433.     }
  434. }
  435.  
  436. # pasteSave --
  437. #    Insert the previously saved deletion
  438.  
  439. proc pasteSave { } {
  440.     global _saved
  441.     if [info exists _saved] {
  442.     insert $_saved
  443.     } else {
  444.     mxFeedback "no saved selection"
  445.     }
  446. }
  447.  
  448. # openLineBelow --
  449.  
  450. proc openLineBelow { } {
  451.     caret [mark caret char -1]
  452.     newline
  453. }
  454.  
  455. # openLineAbove --
  456.  
  457. proc openLineAbove { } {
  458.     insert \n [mark caret char 0]
  459.     caret [mark [mark caret char 0] back 1 char]
  460. }
  461.  
  462. # indentLine --
  463. #    indent the line with the caret
  464. #     A (user-settable) indent variable is used to control the amount
  465.  
  466. proc indentLine { } {
  467.     global indent
  468.     indent caret caret + $indent
  469. }
  470.  
  471. # outdentLine --
  472. #    outdent the line with the caret
  473.  
  474. proc outdentLine { } {
  475.     global indent
  476.     indent caret caret - $indent
  477. }
  478. # indentSel --
  479. # Indent the selected region
  480.  
  481. proc indentSel { } {
  482.     global indent
  483.     indent sel.left sel.right + $indent
  484. }
  485.  
  486. # outdentSel --
  487. # Outdent the selected region
  488.  
  489. proc outdentSel { } {
  490.     global indent
  491.     indent sel.left sel.right - $indent
  492. }
  493.  
  494. # back1char --
  495. #    Move the insert point one character back
  496.  
  497. proc back1char { } {
  498.     caret [mark caret back 1 char]
  499.     see caret
  500. }
  501.  
  502. # forw1char --
  503. #    Move the insert point one character forward
  504.  
  505. proc forw1char { } {
  506.     caret [mark caret forw 1 char]
  507.     see caret
  508. }
  509.  
  510. # back1word --
  511. #    Move the insert point one word backward
  512.  
  513. proc back1word { } {
  514.     caret [mark caret back 1 word]
  515.     see caret
  516. }
  517.  
  518. # forw1word --
  519. #    Move the insert point one word forward
  520.  
  521. proc forw1word { } {
  522.     caret [mark caret forw 1 word]
  523.     see caret
  524. }
  525.  
  526. # nextline --
  527. #    Move the insert point to the begining of the next line
  528.  
  529. proc nextline {}  {
  530.     caret [mark [mark caret forw 1 line] char 0]
  531.     see caret
  532. }
  533.  
  534. # down1line --
  535. #    Move the insert point down one line, maintaining current column
  536.  
  537. set _lastPos 0.0
  538. proc down1line { } {
  539.     global _lastPos _lastCol
  540.  
  541.     if {[string compare $_lastPos [mark caret]] != 0} {
  542.     set _lastCol [column caret]
  543.     }
  544.     set _lastPos [mark [mark caret forw 1 line] column $_lastCol]
  545.     caret $_lastPos
  546.     see caret
  547.     return $_lastPos
  548. }
  549.  
  550. # up1line --
  551. #    Move the insert point up 1 line
  552.  
  553. proc up1line { } {
  554.     global _lastPos _lastCol
  555.  
  556.     if {[string compare $_lastPos [mark caret]] != 0} {
  557.     set _lastCol [column caret]
  558.     }
  559.     set _lastPos [mark [mark caret back 1 line] column $_lastCol]
  560.     caret $_lastPos
  561.     see caret
  562.     return $_lastPos
  563. }
  564.  
  565. # beginOfLine --
  566. #    Move the caret to the beginning of the line
  567.  
  568. proc beginOfLine { } {
  569.     caret [mark caret char 0]
  570.     see caret
  571. }
  572.  
  573. # endOfLine --
  574. #    Move the caret to the end of the line
  575.  
  576. proc endOfLine { } {
  577.     set _t [mark caret char -1]
  578.     if {[string compare [mark caret] $_t] == 0} {
  579.     set _t [mark [mark caret forw 1 line] char -1]
  580.     }
  581.     caret $_t
  582.     see caret
  583. }
  584.  
  585. # pageUp --
  586. #    Move the caret up, towards the beginning of the file, one screen
  587.  
  588. proc pageUp { } {
  589.     scan [geometry] "%dx%d" _width _height
  590.     caret [mark caret back $_height lines]
  591.     see caret
  592. }
  593.  
  594. # pageDown --
  595. #    Move the caret down, towards the end of the file, one screen
  596.  
  597. proc pageDown { } {
  598.     scan [geometry] "%dx%d" _width _height
  599.     caret [mark caret forw $_height lines]
  600.     see caret
  601. }
  602.  
  603. ######################### Basic mxedit Operations #########################
  604. # These are top-level names that map down to widget-instance operations
  605. # These top-level names are used in keystroke bindings.
  606. # The level of indirection allows for easy renames to avoid conflicts
  607. # and it provides a place for hooks added later.
  608.  
  609. # mxBind --
  610. #    This is what users should use to bind keystrokes to the edit window
  611.  
  612. proc mxBind { args } {
  613.     global mxedit
  614.     eval "bind $mxedit $args"
  615. }
  616.  
  617. # caret --
  618. #    caret mark - this positions the insert caret
  619. #    caret display [block|caret] - change caret appearance
  620. proc caret { args } {
  621.     global mxedit
  622.     eval "$mxedit caret $args"
  623. }
  624.  
  625. # clean --
  626. #    Mark the file as clean - but don't really write out its contents
  627.  
  628. proc clean { args } {
  629.     global mxedit
  630.     eval "$mxedit clean $args"
  631. }
  632.  
  633. # column --
  634. #    Return the column corresponding to the left edge of the
  635. #          character at the position indicated by mark.
  636.  
  637. proc column { args } {
  638.     global mxedit
  639.     eval "$mxedit column $args"
  640. }
  641.  
  642. # control --
  643. #    control option string
  644. #    options:
  645. #        backslash -- replace non-printing chars with escape sequences
  646. #        binding -- returns a binding syntax for a string (broken)
  647. #        make -- folds ascii down to control
  648.  
  649. proc control { args } {
  650.     global mxedit
  651.     eval "$mxedit control $args"
  652. }
  653.  
  654. # extract --
  655. #    extract mark1 [mark2]
  656. #    Return all the characters between two marks
  657.  
  658. proc extract { args } {
  659.     global mxedit
  660.     eval "$mxedit extract $args"
  661. }
  662.  
  663. # history --
  664. #    remember actions for the puposes of redo
  665. #    Note this is different than the TCL history command
  666.  
  667. proc history { args } {
  668.     global mxedit
  669.     eval "$mxedit history $args"
  670. }
  671.  
  672. # gridsize --
  673. #    Return a gridsize as determined from the font metrics.  Used
  674. #    in conjuction with the "wm grid" command:
  675. #    eval "wm grid . $baseWidth $baseHeight [gridsize]
  676.  
  677. proc gridsize { args } {
  678.     global mxedit
  679.     eval "$mxedit gridsize $args"
  680. }
  681.  
  682. # indent --
  683. #    indent mark1 mark2 [+|-] amount
  684.  
  685. proc indent { args } {
  686.     global mxedit
  687.     eval "$mxedit indent $args"
  688. }
  689.  
  690. # insert --
  691. #    insert bytes [mark]
  692. #    Defaults to inserting at the caret
  693.  
  694. proc insert { args } {
  695.     global mxedit
  696.     eval "$mxedit insert $args"
  697. }
  698.  
  699. # batchInsert --
  700. #    Use the ! syntax to batch up insertions
  701.  
  702. proc batchInsert { args } {
  703.     global mxedit
  704.     eval "$mxedit ! insert $args"
  705. }
  706.  
  707. # mark --
  708. #    mark src op args
  709. #    Returns a position marker of the form lines.chars
  710. #    See the man page for details
  711.  
  712. proc mark { args } {
  713.     global mxedit
  714.     eval "$mxedit mark $args"
  715. }
  716.  
  717. # newline --
  718. #    Insert a newline character and do auto indentation
  719. proc newline {  } {
  720.     global mxedit
  721.     eval "$mxedit newline "
  722. }
  723.  
  724. # quote --
  725. #    Quote (insert) the next character, ignoring its binding.
  726.  
  727. proc quote {  } {
  728.     global mxedit
  729.     eval "$mxedit quote "
  730. }
  731.  
  732. # read --
  733. #    Read in the contents of a file
  734.  
  735. catch {rename read unixRead}
  736. proc read { args } {
  737.     global mxedit
  738.     eval "$mxedit read $args"
  739. }
  740.  
  741. # replace --
  742. #    replace [option args]
  743. #          replace range start stop [pattern string]
  744. #          replace selection string
  745. #    Replace the selection with a string,
  746. #    or do a replace    within a range
  747. #    If there are no options, then the widget reaches out
  748. #    for the value of mxReplaceString
  749.  
  750. proc replace { args } {
  751.     global mxedit
  752.     catch {
  753.      global find mxReplaceString
  754.      set mxReplaceString [$find.replace.entry get]
  755.     }
  756.     if [catch "$mxedit replace $args" msg] {
  757.     mxFeedback "$msg"
  758.     }
  759. }
  760.  
  761. # search --
  762. #    search [forward|backward] target
  763. #    if there is no target specified, then the widget reaches
  764. #    out for the mxSearchString variable
  765.  
  766. proc search { args } {
  767.     global mxedit
  768.     catch {
  769.      global find mxSearchString
  770.      set mxSearchString [$find.target.entry get]
  771.     }
  772.     if [catch "$mxedit search $args" msg] {
  773.     mxFeedback "$msg"
  774.     }
  775. }
  776.  
  777. # see --
  778. #    see mark [[top|center|bottom]
  779. #    Adjust the view so the mark is visible
  780.  
  781. proc see { args } {
  782.     global mxedit
  783.     eval "$mxedit see $args"
  784. }
  785.  
  786. # mxselection --
  787. #    mxselection get - identical to TK's selection command
  788. #    mxselection clear - clear this window's selection
  789. #    mxselection here - returns 1 if selection is in this window
  790. #    mxselection set mark1 [mark2]
  791.  
  792. proc mxselection { args } {
  793.     global mxedit
  794.     eval "$mxedit selection $args"
  795. }
  796.  
  797. # applyToSelection --
  798. #    Apply a command to the current selection, catching errors.
  799. #    
  800.  
  801. proc applyToSelection { prefix } {
  802.     if [catch {selection get} sel] {
  803.     mxFeedback "$prefix: $sel"
  804.     } else {
  805.     return [eval [concat $prefix [list $sel]]]
  806.     }
  807. }
  808. # taginfo --
  809. #    Returns information from a tags file.
  810.  
  811. proc taginfo { name } {
  812.     global mxedit
  813.     eval "$mxedit taginfo $name"
  814. }
  815.  
  816. # written --
  817. #    Raises an error if the file is dirty.
  818.  
  819. proc written { args } {
  820.     global mxedit
  821.     eval "$mxedit written $args"
  822. }
  823.  
  824. ############################### Callbacks ##########################
  825.  
  826. # If the following procedures are defined, they are invoked by
  827. # the mxedit implementation to notify the script-level about
  828. # internal state changes
  829.  
  830. # mxSizeChangeCallback --
  831. #    Called when the geometry of the window changes
  832. #    This is called as a result of ConfigureNotify X events,
  833. #    which are apparently only generated when the size changes,
  834. #    not the location.
  835.  
  836. proc mxSizeChangeCallback { } {
  837. #    mxFeedback "New geometry: [geometry] [winfo geometry .]"
  838. }
  839.  
  840. # mxStateChangeCallback --
  841. #    Called when the clean/dirty state of the file changes
  842.  
  843. proc mxStateChangeCallback { } {
  844.     global file
  845.     mxNameWindow . $file
  846. }
  847.  
  848.  
  849. ############################### Abbreviations #######################
  850.  
  851. # Very weak support for abbreviations that could ultimately be
  852. # expanded to support editing modes (like C or M3 mode)
  853.  
  854. # mxAbbrev --
  855. #    Set up an abbreviation so that typing the short sequence
  856. #    is equivalent to the longer one.
  857.  
  858. proc mxAbbrev { abbrev args } {
  859.     mxBind $abbrev "delete caret \[mark caret back [expr [string length $abbrev]-1] chars\] ; insertWords $args"
  860. }
  861.  
  862. # insertWords --
  863. #    Insert a bunch of words.  This won't do the right thing with tabs.
  864.  
  865. proc insertWords { args } {
  866.     set space {}
  867.     foreach word $args {
  868.     batchInsert $space
  869.     batchInsert $word
  870.     set space " "
  871.     }
  872. }
  873. ############################### Miscellany ##########################
  874.  
  875. # geometry --
  876. #    Set the window's X geometry
  877.  
  878. proc geometry { { xGeometry none } } {
  879.     if { [string compare $xGeometry none] == 0} {
  880.     return [wm geometry .]
  881.     } else {
  882.     return [wm geometry . $xGeometry]
  883.     }
  884. }
  885.  
  886. # screenwidth --
  887. #    Return the width of the screen
  888.  
  889. proc screenwidth {} {
  890.     global mxedit
  891.     return [winfo screenwidth $mxedit]
  892. }
  893.  
  894. # screenheight --
  895. #    Return the height of the screen
  896.  
  897. proc screenheight {} {
  898.     global mxedit
  899.     return [winfo screenheight $mxedit]
  900. }
  901.  
  902. # line --
  903. #    Make a particular line visible
  904.  
  905. proc line { i } {
  906.     if {[scan $i %d _t] != 1} {error [format {bad line number "%s"} $i]}
  907.     set _t [format %d.0 $i]
  908.     see $_t
  909.     mxselection set $_t [mark $_t char -1]
  910.     caret $_t
  911. }
  912.  
  913. # tag --
  914. #    Switch files and tag to the given name.
  915.  
  916. proc tag { name } {
  917.     global mxedit
  918.     if [catch {taginfo $name} i] {
  919.     mxFeedback $i
  920.     } else {
  921.     switch [lindex $i 0]
  922.     search forw [lindex $i 1]
  923.     }
  924. }
  925.  
  926. # tagOpen --
  927. #    Open a new window and tag to the given name.
  928.  
  929. proc tagOpen { name } {
  930.     global mxedit
  931.     if [catch {taginfo $name} i] {
  932.     mxFeedback "$i"
  933.     } else {
  934.     set newWindow [mxopen [lindex $i 0]]
  935.     send $newWindow "search forw \{[lindex $i 1]\}"
  936.     }
  937. }
  938.  
  939. # caretInfo --
  940. #    Returns lines and caret information
  941.  
  942. proc caretInfo { } {
  943.     global file
  944.     scan [mark eof] %d _t
  945.     scan [mark caret] %d _t2
  946.     return [format {\"%s\" : %d total lines, caret on line %d} $file $_t $_t2]
  947. }
  948.  
  949. proc showProcs {args} {
  950.     set newWindow [mxopen {}]
  951.     send $newWindow {insert Procedure\ information:\n}
  952.     send $newWindow {insert ---------\ -----------}
  953.     if {[llength $args] == 0} {set args [lsort [info procs]]}
  954.     foreach proc $args {
  955.     set space {}
  956.     send $newWindow [list insert [format \n\n%s( $proc]]
  957.     send $newWindow clean
  958.     foreach param [info args $proc] {
  959.         send $newWindow [list insert [format %s%s $space $param]]
  960.         set space {, }
  961.         if [info default $proc $param default] {
  962.         send $newWindow [list insert [format { [%s]} $default]]
  963.         }
  964.     }
  965.     send $newWindow {insert ):\n}
  966.     send $newWindow [list insert [info body $proc]]
  967.     }
  968.     send $newWindow clean
  969.     send $newWindow {see 0.0}
  970. }
  971.  
  972. proc showVars {args} {
  973.     set newWindow [mxopen {}]
  974.     send $newWindow {insert Variable\ values:\n}
  975.     send $newWindow {insert --------\ -------\n}
  976.     set _maxLength 10
  977.     if {[llength $args] == 0} {set args [lsort [uplevel #0 {info vars}]]}
  978.     foreach _i $args {
  979.     if {[string length $_i] > $_maxLength} {
  980.         set _maxLength [string length $_i]
  981.     }
  982.     }
  983.     set _maxLength [expr $_maxLength+6]
  984.     set format "\\n%-${_maxLength}s = \"%s\""
  985.     foreach _i $args {
  986.     if [catch {uplevel #0 "set $_i"} value] {
  987.         # The variable is probably an array
  988.         set _maxLength 10
  989.         if {[catch {lsort [uplevel #0 "array names $_i"]} names] == 0} {
  990. #        foreach _j $names {
  991. #            if {[string length $_j] > $_maxLength} {
  992. #            set _maxLength [string length $_j]
  993. #            }
  994. #        }
  995. #        set _maxLength [expr $_maxLength+[string length $_i]+2]
  996. #        set format2 "\\n%-${_maxLength}s = \"%s\""
  997.         set format2 $format
  998.         foreach _j $names {
  999.             if {[catch {uplevel #0 "set ${_i}($_j)"} value] == 0} {
  1000.             send $newWindow [list insert \
  1001.                 [format $format2 \
  1002.                     [format "%s(%s)" $_i $_j] $value]]
  1003.             }
  1004.         }
  1005.         }
  1006.     } else {
  1007.         send $newWindow [list insert [format $format $_i $value]]
  1008.     }
  1009.     }
  1010.     send $newWindow clean
  1011.     send $newWindow {see 0.0}
  1012. }
  1013.  
  1014.  
  1015. #
  1016. # placePopUp -
  1017. #    Place a popup relative to its parent window
  1018. #
  1019. proc placePopUp { widget {where center} } {
  1020.     global mxedit
  1021.  
  1022.     if {[string compare [screenwidth] unknown] == 0} {
  1023.     set screenWidth [lindex [exec xwininfo -root | egrep Width:] 2]
  1024.     set screenHeight [lindex [exec xwininfo -root | egrep Height:] 2]
  1025.     }
  1026.  
  1027.     scan [wm geometry .] "%dx%d+%d+%d" charsWide linesHigh xoff yoff
  1028. #    puts stderr "Geometry $charsWide $linesHigh $xoff $yoff"
  1029.     
  1030.     set gridWidth [lindex [$mxedit gridsize] 0]
  1031.     set gridHeight [lindex [$mxedit gridsize] 1]
  1032.     set mainWidth [expr {$charsWide * $gridWidth}]
  1033.     set mainHeight [expr {$linesHigh * $gridHeight}]
  1034.  
  1035.     wm withdraw $widget
  1036.     update
  1037.     scan [wm geometry $widget] "%dx%d" itsWidth itsHeight    
  1038. #    puts stderr "Its $itsWidth $itsHeight"
  1039.  
  1040.     set leftRoom $xoff 
  1041.     set rightRoom [expr {[screenwidth] - $xoff - $mainWidth}]
  1042.  
  1043.     set topRoom $yoff 
  1044.     set bottomRoom [expr {[screenheight] - $yoff - $mainHeight}]
  1045.  
  1046.     case $where in {
  1047.     "off" {
  1048. #        puts stderr "placePopUp " nonewline
  1049.         if {$leftRoom > $rightRoom} {
  1050.         set itsXoff [expr {$xoff - $itsWidth}]
  1051.         if {$itsXoff < 0} {
  1052.             set itsXoff 0
  1053.         }
  1054. #        puts stderr "left $itsXoff " nonewline
  1055.         } else {
  1056.         set itsXoff [expr {$xoff + $mainWidth}]
  1057.         if {[expr {$itsXoff + $itsWidth}] > [screenwidth]} {
  1058.             set itsXoff [expr {[screenwidth] - $itsWidth}]
  1059.         }
  1060. #        puts stderr "right $itsXoff " nonewline
  1061.         }
  1062.         if {$topRoom > $bottomRoom} {
  1063.         set itsYoff [expr {$yoff - $itsHeight}]
  1064.         if {$itsYoff < 0} {
  1065.             set itsYoff 0
  1066.         }
  1067. #        puts stderr "top $itsYoff " nonewline
  1068.         } else {
  1069.         set itsYoff [expr {$yoff + $mainHeight}]
  1070.         if {[expr {$itsYoff + $itsHeight}] > [screenheight]} {
  1071.             set itsYoff [expr {[screenheight] - $itsHeight}]
  1072.         }
  1073. #        puts stderr "bottom $itsYoff " nonewline
  1074.         }
  1075.     }
  1076.     { default center } {
  1077.         if {[string compare $where center] == 0} {
  1078.         set itsXoff [expr {$xoff + ($mainWidth - $itsWidth) / 2}]
  1079.         set itsYoff [expr {$yoff + ($mainHeight - $itsHeight) / 2}]
  1080.         }
  1081.     }
  1082.     }
  1083.     wm geometry $widget +${itsXoff}+${itsYoff}
  1084.     wm deiconify $widget
  1085. }
  1086.  
  1087.